COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 A B C D E XPN DMP SYSSAV IMPFS test GSYM FINISH NOLOOK XPNFIL DMPFIL CMD0 CMD1 CMD2 CMD3 CMD4 ONEREC SYMPG FSTREC
C00011 ENDMK
C⊗;
;⊗ A B C D E XPN DMP SYSSAV IMPFS test GSYM FINISH NOLOOK XPNFIL DMPFIL CMD0 CMD1 CMD2 CMD3 CMD4 ONEREC SYMPG FSTREC

;Program to save currently running system's core in WAITS.XPN,
;which can then be converted to .DMP format with FILEX.

TITLE SYSSAV

A←1
B←2
C←3
D←4
E←5

;I/O channels
XPN←←1	;output
DMP←←2	;input

SYSSAV:	RESET
	INIT XPN,17
	 'DSK   '
	 0
	 HALT .
	MOVE D,[XPNFIL,,A]
	BLT D,D			;load name of file to write
	ENTER XPN,A
	 HALT .
	MOVEI A,XPN
	SHOWIT A,		;put file on wholine
	MOVSI A,377777
	SETPR2 A,		;map first part of system into upper
	 HALT .
repeat 1,< ; make sure we get low core
	OUT XPN,CMD0		;first 200 words, probably output as zeroes
	 CAIA			; (symbol ptr get stuck in there later)
	HALT .
	OUT XPN,CMD2		;output rest of first 200000 words
	 CAIA
	HALT .
>;repeat 1
repeat 0,< ; for some reason, this writes only zeroes in first page of output.
	OUT XPN,CMD1		;write first part of system into file (pages 0:177)
	 CAIA
	HALT .
>;repeat 0
	MOVE A,[377777,,200000]
	SETPR2 A,		;map second part of system
	 HALT .
	OUT XPN,CMD1		;write second part (pages 200:377)
	 CAIA
	HALT .
	MOVE A,[377777,,400000]
	SETPR2 A,		;map third part
	 HALT .
	OUT XPN,CMD1		;write third part (pages 400:577)
	 CAIA
	HALT .

	MOVE A,[377777,,600000]
	SETPR2 A,		;map fourth part of system
	 HALT .
	OUT XPN,CMD3		;write only little of fourth quarter (to IMPFS),
	 CAIA			; leaving room for symbols in second half thereof
	HALT .

	INIT DMP,17
	 'DSK   '
	 0
	 HALT .
	MOVE D,[DMPFIL,,A]
	BLT D,D			;load name of DMP file to read symbols from
	LOOKUP DMP,A
	 JRST NOLOOK
	MOVEI A,DMP
	SHOWIT A,
	IN DMP,ONEREC		;read first record, to get symbol ptr
	 CAIA
	HALT .
	MOVE B,FSTREC+JOBSYM↑-JOBSAV↑-1 ;get symbol table ptr
	HLRE B,B		;negative symbol table length
	ASH B,-9		;negative symbol table length in pages (round up)
	ADDI B,1000		;figure page where we want symbols to start
	MOVEM B,SYMPG		;remember that page number
	CAIG B,IMPFS		;better be beyond IMPFS (some room for IMP FS)
	HALT .

;SYMPAG←←700	;pa where symbols will go in file
IMPFS←←620	;page where high FS starts (assume consecutive phys pages)
;If you change IMPFS, change CMD3 too.
test:	MOVEI A,343		;loc of ptr to EXPGT
	PEEK A,			;get EXPGT
	SKIPN A
	HALT .
	ADDI A,IMPFS		;get address of entry for beginning of high FS
	PEEK A,			;get page table entry for beginning of high FS
	SKIPN A
	HALT .
	LSH A,5			;multiply by 40 for GETHI
	HRLI A,-IMPFS(B)	;number of pages to include in our map
;	HRLI A,SYMPAG-IMPFS	;number of pages to include in our map
;	MOVE AC,[# OF PAGES,,STARTING PAGE*40+WENB]
	GETHI A,		;map IMP buffers of system
	 HALT .
	SUBI B,IMPFS		;number of pages of IMP buffers to write out
	MOVN B,B		;negative page count to write
	ASH B,9			;negative word count of IMP buffers to write
	HRLM B,CMD4		;store negative wd ct in IOWD
	OUT XPN,CMD4		;write as if IMP buffer went to SYMPG⊗9-1
	 CAIA			; leaving room for symbols at page SYMPG
	HALT .

GSYM:	MOVE B,FSTREC+JOBSYM↑-JOBSAV↑-1 ;get symbol table ptr
	SUBI B,JOBSAV+1		;make ptr relative to dmp file, to read symbols
	HRRZ C,B
	LSH C,-7		;record where symbols start
	USETI DMP,1(C)		;position to read there
	MOVE C,B
	ANDI C,177		;offset within record where symbols start
	HLRE D,B		;negative length of symbol table
	SUBB D,C		;-distance to end of symbols from record start
	HRLZ D,D		;that's amt to read
	ADDI D,FSTREC-1		;where to read in to
	MOVEI E,0		;end of IOWD cmd list
	SUBI C,FSTREC		;make negative of core ending address of symbols
	MOVN C,C		;positive ending address
	CORE C,			;make sure we have enough core for symbols
	 HALT .
	IN DMP,D		;read in symbols
	 CAIA
	HALT .
	OUT XPN,D		;write out symbols at page SYMPG+offset in record
	 CAIA
	HALT .
	TRZ B,777600		;turn symbol table ptr to page SYMPG+old offset
	MOVE A,SYMPG		;page where symbols go
	LSH A,9			;wd address of symbols' page
	IOR B,A			;set address of symbols in XPN file
;	TRO B,SYMPAG⊗9		;this is addr in XPN file of symbols
	USETO XPN,1		;position to first record to write out ptr
	SETZM FSTREC
	MOVE A,[FSTREC,,FSTREC+1]
	BLT A,FSTREC+177	;zero the whole first record
	MOVEM B,FSTREC+JOBSYM	;store in proper place in XPN file's first record
	OUT XPN,ONEREC		;re-write first record
	 CAIA
	HALT .
FINISH:	RELEAS XPN,
	RELEAS DMP,
	EXIT

NOLOOK:	OUTSTR [ASCIZ/
Can't lookup WAITS.DMP[S,SYS] to copy symbols.
Type CONTINUE to close output file without symbols or IMP buffers./]
	EXIT 1,
	JRST FINISH

XPNFIL:	'WAITS '
	'XPN   '
	0↔0

DMPFIL:	'WAITS '
	'DMP   '
	0
	'  SSYS'

CMD0:	-200,,377777		;Disk output IOWD, first record only
	0

CMD1:	-200000,,377777		;Disk output IOWD
	0

CMD2:	-200000+200,,377777+200	;Disk output IOWD, all but first record
	0

CMD3:	-<IMPFS-600>⊗9,,377777	;Disk output IOWD, for physical pages 600-617
	0

CMD4:	-<0-0>⊗9,,377777	;Disk output IOWD, for virtual pages 620:SYMPG-1
	0			;LH of IOWD above is set at runtime

ONEREC:	-200,,FSTREC-1		;IOWD to read/write one record
	0

SYMPG:	0			;number of page where symbols go in XPN file

	LIT
	VAR

FSTREC:	BLOCK 200
;actually, we expand up from here to
;make room for symbols from DMP file,
;thus clobbering user DDT's symbols if they're
;loaded above here.

	END SYSSAV